title: “Lab3” output: html_notebook — install packages **Uncomment
library(ggplot2)## Warning: package 'ggplot2' was built under R version 3.4.2library(dplyr)## Warning: package 'dplyr' was built under R version 3.4.2##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(imager)## Warning: package 'imager' was built under R version 3.4.2## Loading required package: plyr## Warning: package 'plyr' was built under R version 3.4.2## -------------------------------------------------------------------------## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)## -------------------------------------------------------------------------##
## Attaching package: 'plyr'## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize## Loading required package: magrittr## Warning: package 'magrittr' was built under R version 3.4.2##
## Attaching package: 'imager'## The following object is masked from 'package:magrittr':
##
## add## The following object is masked from 'package:plyr':
##
## liply## The following objects are masked from 'package:stats':
##
## convolve, spectrum## The following object is masked from 'package:graphics':
##
## frame## The following object is masked from 'package:base':
##
## save.imagelibrary(tidyr)## Warning: package 'tidyr' was built under R version 3.4.2##
## Attaching package: 'tidyr'## The following object is masked from 'package:imager':
##
## fill## The following object is masked from 'package:magrittr':
##
## extractlibrary(reshape2)## Warning: package 'reshape2' was built under R version 3.4.2##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithsLoad test image
im <- load.image("./lab3test.png")## Warning in readfun(f, ...): libpng warning: iCCP: known incorrect sRGB
## profilebdf <- as.data.frame(im)
head(bdf,3)## x y cc value
## 1 1 1 1 0.4313725
## 2 2 1 1 0.6156863
## 3 3 1 1 0.7529412plot(im)
Get info on image
dim(im)## [1] 1968 1440 1 3create a histogram for each color channels rgb value frequency
R(im) %>% hist(main="Red Band values Frequency in Test Image");G(im) %>% hist(main="Green Band values Frequency in Test Image");B(im) %>% hist(main="Blue Band values Frequency in Test Image")
Create a data frame to store pic in and create header for df and plot it
picdataframe <- as.data.frame(im)
head(picdataframe,3)## x y cc value
## 1 1 1 1 0.4313725
## 2 2 1 1 0.6156863
## 3 3 1 1 0.7529412use picture data frame with gg plot to create 3 histograms for each channels pixel freq
picdataframe <- plyr::mutate(picdataframe,channel=factor(cc,labels=c('Red','Green','Blue')))
ggplot(picdataframe,aes(value,col=channel))+geom_histogram(bins=45)+facet_wrap(~ channel)
Plot equlaized image using Empricial Cumulative Distribution Function
hist.eq <- function(im) as.cimg(ecdf(im)(im),dim=dim(im))
split <- imsplit(im,"c")
split## Image list of size 3split.eq <- llply(split,hist.eq)
imappend(split.eq,"c") %>% plot(main="3 channel Hist Equalization using Empricial Cumulative Distribution Function")
Perform Image Gradient Magnitude analysis using imageR function
im.g <- grayscale(im)
imgradient(im.g,"xy") %>% enorm %>% plot(main="Gradient magnitude")
im.g## Image. Width: 1968 pix Height: 1440 pix Depth: 1 Colour channels: 1Calculating Hessian values using Image gradient
imhessian(im.g)## Image list of size 3Determine Determinat of Hessian matrix
Hdet <- with(imhessian(im),(xx*yy - xy^2))
plot(Hdet,main="Determinant of Hessian")
Map the top 1% of Determinant values (high change areas)
threshold(Hdet,"99%") %>% plot(main="Determinant: 1% highest values")
For programs sake label regions
lab <- threshold(Hdet,"99%") %>% label
plot(lab,main="Labeled regions")
Convert to a df, plot df
df <- as.data.frame(lab) %>% subset(value>0)
head(df,3)## x y cc value
## 2588 620 2 1 1
## 2599 631 2 1 2
## 4039 103 3 1 3Calculate center
centers <- ddply(df,.(value),summarise,mx=mean(x),my=mean(y))plot(im)
with(centers,points(mx,my,col="red"))
Blob detection using multi scalular aproach 1- blur images to reduce noise 2- Determine Hessian values at different zoome levels(scale) 3- Plot deteriment values for each scale using gg plot
hessdet <- function(im,scale=1) isoblur(im,scale) %>% imhessian %$% { scale^2*(xx*yy - xy^2) }
dat <- ldply(c(5,3,4),function(scale) hessdet(im,scale) %>% as.data.frame %>% mutate(scale=scale))
p <- ggplot(dat,aes(x,y))+geom_raster(aes(fill=value))+facet_wrap(~ scale)
p+scale_x_continuous(expand=c(0,0))+scale_y_continuous(expand=c(0,0),trans=scales::reverse_trans())
Combine these scales in to one function
scales <- seq(2,20,l=10)
d.max <- llply(scales,function(scale) hessdet(im,scale)) %>% parmax
plot(d.max,main="Maximum Hessian across scales")
Calculate the max across the multiple scales plot results of max hessian value colored by scale
i.max <- llply(scales,function(scale) hessdet(im,scale)) %>% which.parmax
plot(i.max,main="Maximum Hessian Value across scales")
Use ggplot to plot the grey scale imagery plus the mean centers of highest .1% of hessian values with triangles over top of them (size of the triangle indicates how many times the center was picked up in the multi scale analysis)
labs <- d.max %>% threshold("99.9%") %>% label %>% as.data.frame
labs <- mutate(labs,index=as.data.frame(i.max)$value)
regs <- dplyr::group_by(labs,value) %>% dplyr::summarise(mx=mean(x),my=mean(y),scale.index=mean(index))
p <- ggplot(as.data.frame(im),aes(x,y))+geom_raster(aes(fill=value))+geom_point(data=regs,aes(mx,my,size=scale.index),pch=2,col="red")
p+scale_fill_gradient(low="black",high="white")+scale_x_continuous(expand=c(0,0))+scale_y_continuous(expand=c(0,0),trans=scales::reverse_trans())
Testing capabilities of spectral plots. In the future will be workint to gather spectral plots of pixels located by the local maximas within at least 2 scales
imrow(G(im),60) %>% plot(main="Green 60th row",type="l")
Applying a smoothing threadhold based linear Model
d <- as.data.frame(im)
m <- sample_n(d,1e4) %>% lm(value ~ x*y,data=.)
im.c <- im-predict(m,d)
out <- threshold(im.c)
plot(out)
testing Gaussian Blur effect
imblur<-grayscale(isoblur(im,5, gaussian =TRUE))
plot(imblur)
plot(im) Dividing image based on imageR threshold- not to usesful
threshold(imblur) %>% plot
Playing with methods of plotting multiple spectral plots first attempt
both<-("./plots.csv")
bothDf<-read.csv(both)
ggplot(data = bothDf, aes(x=WaveLength, y=Rrs_sim)) + geom_line(aes(y=Rrs_sim, colour=Rrs_sim)) +geom_line(aes(y=Rrs_lid, colour=Rrs_lid))
2nd attempt with data “melted” into long form
melted.both <- melt(bothDf, id="WaveLength") # convert to long format
ggplot(data = melted.both,
aes(x=WaveLength, y=value, colour=variable)) +
geom_line()